home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / tcl / extend / src.unused / tclXfcntl.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-10-26  |  10.6 KB  |  372 lines  |  [TEXT/MPS ]

  1. /*
  2.  * tclXfcntl.c
  3.  *
  4.  * Extended Tcl fcntl command.
  5.  *-----------------------------------------------------------------------------
  6.  * Copyright 1991-1993 Karl Lehenbauer and Mark Diekhans.
  7.  *
  8.  * Permission to use, copy, modify, and distribute this software and its
  9.  * documentation for any purpose and without fee is hereby granted, provided
  10.  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11.  * Mark Diekhans make no representations about the suitability of this
  12.  * software for any purpose.  It is provided "as is" without express or
  13.  * implied warranty.
  14.  *-----------------------------------------------------------------------------
  15.  * $Id: tclXfcntl.c,v 2.7 1993/07/30 15:05:15 markd Exp $
  16.  *-----------------------------------------------------------------------------
  17.  */
  18.  
  19. #include "tclExtdInt.h"
  20.  
  21. /*
  22.  * Macro to enable line buffering mode on a file.  The macros assure that the
  23.  * resulting expression returns zero if the function call does not return
  24.  * a value.
  25.  */
  26. #ifdef HAVE_SETLINEBUF
  27. #   define SET_LINE_BUF(fp)  (setlinebuf (fp),0)
  28. #else
  29. #   define SET_LINE_BUF(fp)  setvbuf (fp, NULL, _IOLBF, BUFSIZ)
  30. #endif
  31.  
  32. /*
  33.  * If we don't have O_NONBLOCK, use O_NDELAY.
  34.  */
  35. #ifndef O_NONBLOCK
  36. #   define O_NONBLOCK O_NDELAY
  37. #endif
  38.  
  39. /*
  40.  * Attributes used by fcntl command and the maximum length of any attribute
  41.  * name.
  42.  */
  43. #define   ATTR_CLOEXEC  1
  44. #define   ATTR_NOBUF    2
  45. #define   ATTR_LINEBUF  4
  46. #define   MAX_ATTR_NAME_LEN  20
  47.  
  48. /*
  49.  * Prototypes of internal functions.
  50.  */
  51. static int
  52. XlateFcntlAttr  _ANSI_ARGS_((Tcl_Interp *interp,
  53.                              char       *attrName,
  54.                              int        *fcntlAttrPtr,
  55.                              int        *otherAttrPtr));
  56.  
  57. static int
  58. GetFcntlAttr _ANSI_ARGS_((Tcl_Interp *interp,
  59.                           FILE       *filePtr,
  60.                           char       *attrName));
  61.  
  62. static int
  63. SetFcntlAttr _ANSI_ARGS_((Tcl_Interp *interp,
  64.                           FILE       *filePtr,
  65.                           char       *attrName,
  66.                           char       *valueStr));
  67.  
  68. /*
  69.  *-----------------------------------------------------------------------------
  70.  *
  71.  * XlateFcntlAttr --
  72.  *    Translate an fcntl attribute.
  73.  *
  74.  * Parameters:
  75.  *   o interp (I) - Tcl interpreter.
  76.  *   o attrName (I) - The attrbute name to translate, maybe upper or lower
  77.  *     case.
  78.  *   o fcntlAttrPtr (O) - If the attr specified is one of the standard
  79.  *     fcntl attrs, it is returned here, otherwise zero is returned.
  80.  *   o otherAttrPtr (O) - If the attr specified is one of the additional
  81.  *     attrs supported by the Tcl command, it is returned here, otherwise
  82.  *     zero is returned.
  83.  * Result:
  84.  *   Returns TCL_OK if all is well, TCL_ERROR if there is an error.
  85.  *-----------------------------------------------------------------------------
  86.  */
  87. static int
  88. XlateFcntlAttr (interp, attrName, fcntlAttrPtr, otherAttrPtr)
  89.     Tcl_Interp *interp;
  90.     char       *attrName;
  91.     int        *fcntlAttrPtr;
  92.     int        *otherAttrPtr;
  93. {
  94.     char attrNameUp [MAX_ATTR_NAME_LEN];
  95.  
  96.     *fcntlAttrPtr = 0;
  97.     *otherAttrPtr = 0;
  98.  
  99.     if (strlen (attrName) >= MAX_ATTR_NAME_LEN)
  100.         goto invalidAttrName;
  101.  
  102.     Tcl_UpShift (attrNameUp, attrName);
  103.  
  104.     if (STREQU (attrNameUp, "RDONLY")) {
  105.         *fcntlAttrPtr = O_RDONLY;
  106.         return TCL_OK;
  107.     }
  108.     if (STREQU (attrNameUp, "WRONLY")) {
  109.         *fcntlAttrPtr = O_WRONLY;
  110.         return TCL_OK;
  111.     }
  112.     if (STREQU (attrNameUp, "RDWR")) {
  113.         *fcntlAttrPtr = O_RDWR;
  114.         return TCL_OK;
  115.     }
  116.     if (STREQU (attrNameUp, "READ")) {
  117.         *fcntlAttrPtr = O_RDONLY | O_RDWR;
  118.         return TCL_OK;
  119.     }
  120.     if (STREQU (attrNameUp, "WRITE")) {
  121.         *fcntlAttrPtr = O_WRONLY | O_RDWR;
  122.         return TCL_OK;
  123.     }
  124.     if (STREQU (attrNameUp, "NONBLOCK")) {
  125.         *fcntlAttrPtr = O_NONBLOCK;
  126.         return TCL_OK;
  127.     }
  128.     if (STREQU (attrNameUp, "APPEND")) {
  129.         *fcntlAttrPtr = O_APPEND;
  130.         return TCL_OK;
  131.     }
  132.     if (STREQU (attrNameUp, "CLOEXEC")) {
  133.         *otherAttrPtr = ATTR_CLOEXEC;
  134.         return TCL_OK;
  135.     }
  136.     if (STREQU (attrNameUp, "NOBUF")) {
  137.         *otherAttrPtr = ATTR_NOBUF;
  138.         return TCL_OK;
  139.     }
  140.     if (STREQU (attrNameUp, "LINEBUF")) {
  141.         *otherAttrPtr = ATTR_LINEBUF;
  142.         return TCL_OK;
  143.     }
  144.  
  145.     /*
  146.      * Error return code.
  147.      */
  148.   invalidAttrName:
  149.     Tcl_AppendResult (interp, "unknown attribute name \"", attrName,
  150.                       "\", expected one of APPEND, CLOEXEC, LINEBUF, ",
  151.                       "NONBLOCK, NOBUF, READ, RDONLY, RDWR, WRITE, WRONLY",
  152.                       (char *) NULL);
  153.     return TCL_ERROR;
  154.  
  155. }
  156.  
  157. /*
  158.  *-----------------------------------------------------------------------------
  159.  *
  160.  * GetFcntlAttr --
  161.  *    Return the value of a specified fcntl attribute.
  162.  *
  163.  * Parameters:
  164.  *   o interp (I) - Tcl interpreter, value is returned in the result
  165.  *   o filePtr (I) - Pointer to the file descriptor.
  166.  *   o attrName (I) - The attrbute name to translate, maybe upper or lower
  167.  *     case.
  168.  * Result:
  169.  *   Returns TCL_OK if all is well, TCL_ERROR if fcntl returns an error.
  170.  *-----------------------------------------------------------------------------
  171.  */
  172. static int
  173. GetFcntlAttr (interp, filePtr, attrName)
  174.     Tcl_Interp *interp;
  175.     FILE       *filePtr;
  176.     char       *attrName;
  177. {
  178.     int fcntlAttr, otherAttr, current;
  179.  
  180.     if (XlateFcntlAttr (interp, attrName, &fcntlAttr, &otherAttr) != TCL_OK)
  181.         return TCL_ERROR;
  182.  
  183.     if (fcntlAttr != 0) {
  184.         current = fcntl (fileno (filePtr), F_GETFL, 0);
  185.         if (current == -1)
  186.             goto unixError;
  187.         interp->result = (current & fcntlAttr) ? "1" : "0";
  188.         return TCL_OK;
  189.     }
  190.     
  191.     if (otherAttr & ATTR_CLOEXEC) {
  192.         current = fcntl (fileno (filePtr), F_GETFD, 0);
  193.         if (current == -1)
  194.             goto unixError;
  195.         interp->result = (current & 1) ? "1" : "0";
  196.         return TCL_OK;
  197.     }
  198.  
  199.     /*
  200.      * Poke the stdio FILE structure to determine the buffering status.
  201.      * This is nasty, _IONBF is the System V flag and _SNBF is the BSD
  202.      * flag.  However some systems using BSD also define _IONBF (yuk).
  203.      * Also some BSDs use __SNBF.
  204.      */
  205. #if defined(__SNBF) && !defined (_SNBF)
  206. #    define _SNBF __SNBF
  207. #    define _SLBF __SLBF
  208. #endif
  209.  
  210. #if defined (linux)
  211.     if (otherAttr & ATTR_NOBUF) {
  212.         interp->result = (filePtr->_flags & _IONBF) ? "1" : "0";
  213.         return TCL_OK;
  214.     }
  215.     if (otherAttr & ATTR_LINEBUF) {
  216.         interp->result = (filePtr->_flags & _IOLBF) ? "1" : "0";
  217.         return TCL_OK;
  218.     }
  219. #define TCL_STDIOBUF
  220. #endif
  221. #if (!defined(TCL_STDIOBUF)) && (defined(_IONBF) && !defined(_SNBF))
  222.     if (otherAttr & ATTR_NOBUF) {
  223.         interp->result = (filePtr->_flag & _IONBF) ? "1" : "0";
  224.         return TCL_OK;
  225.     }
  226.     if (otherAttr & ATTR_LINEBUF) {
  227.         interp->result = (filePtr->_flag & _IOLBF) ? "1" : "0";
  228.         return TCL_OK;
  229.     }
  230. #define TCL_STDIOBUF
  231. #endif
  232. #if !defined(TCL_STDIOBUF)
  233.     if (otherAttr & ATTR_NOBUF) {
  234.         interp->result = (filePtr->_flags & _SNBF) ? "1" : "0";
  235.         return TCL_OK;
  236.     }
  237.     if (otherAttr & ATTR_LINEBUF) {
  238.         interp->result = (filePtr->_flags & _SLBF) ? "1" : "0";
  239.         return TCL_OK;
  240.     }
  241. #define TCL_STDIOBUF
  242. #endif
  243.  
  244. unixError:
  245.     interp->result = Tcl_PosixError (interp);
  246.     return TCL_ERROR;
  247. }
  248.  
  249. /*
  250.  *-----------------------------------------------------------------------------
  251.  *
  252.  * SetFcntlAttr --
  253.  *    Set the specified fcntl attr to the given value.
  254.  *
  255.  * Parameters:
  256.  *   o interp (I) - Tcl interpreter, value is returned in the result
  257.  *   o filePtr (I) - Pointer to the file descriptor.
  258.  *   o attrName (I) - The attrbute name to translate, maybe upper or lower
  259.  *     case.
  260.  *   o valueStr (I) - The string value to set the attribiute to.
  261.  *
  262.  * Result:
  263.  *   Returns TCL_OK if all is well, TCL_ERROR if there is an error.
  264.  *-----------------------------------------------------------------------------
  265.  */
  266. static int
  267. SetFcntlAttr (interp, filePtr, attrName, valueStr)
  268.     Tcl_Interp *interp;
  269.     FILE       *filePtr;
  270.     char       *attrName;
  271.     char       *valueStr;
  272. {
  273.  
  274.     int fcntlAttr, otherAttr, current, setValue;
  275.  
  276.     if (Tcl_GetBoolean (interp, valueStr, &setValue) != TCL_OK)
  277.         return TCL_ERROR;
  278.  
  279.     if (XlateFcntlAttr (interp, attrName, &fcntlAttr, &otherAttr) != TCL_OK)
  280.         return TCL_ERROR;
  281.  
  282.     /*
  283.      * Validate that this the attribute may be set (or cleared).
  284.      */
  285.  
  286.     if (fcntlAttr & (O_RDONLY | O_WRONLY | O_RDWR)) {
  287.         Tcl_AppendResult (interp, "Attribute \"", attrName, "\" may not be ",
  288.                           "altered after open", (char *) NULL);
  289.         return TCL_ERROR;
  290.     }
  291.  
  292.     if ((otherAttr & (ATTR_NOBUF | ATTR_LINEBUF)) && !setValue) {
  293.         Tcl_AppendResult (interp, "Attribute \"", attrName, "\" may not be ",
  294.                           "cleared once set", (char *) NULL);
  295.         return TCL_ERROR;
  296.     }
  297.  
  298.     if (otherAttr == ATTR_CLOEXEC) {
  299.         if (fcntl (fileno (filePtr), F_SETFD, setValue) == -1)
  300.             goto unixError;
  301.         return TCL_OK;
  302.     }
  303.  
  304.     if (otherAttr == ATTR_NOBUF) {
  305.         setbuf (filePtr, NULL);
  306.         return TCL_OK;
  307.     }
  308.  
  309.     if (otherAttr == ATTR_LINEBUF) {
  310.         if (SET_LINE_BUF (filePtr) != 0)
  311.             goto unixError;
  312.         return TCL_OK;
  313.     }
  314.  
  315.     /*
  316.      * Handle standard fcntl attrs.
  317.      */
  318.        
  319.     current = fcntl (fileno (filePtr), F_GETFL, 0);
  320.     if (current == -1)
  321.         goto unixError;
  322.     current &= ~fcntlAttr;
  323.     if (setValue)
  324.         current |= fcntlAttr;
  325.     if (fcntl (fileno (filePtr), F_SETFL, current) == -1)
  326.         goto unixError;
  327.  
  328.     return TCL_OK;
  329.  
  330.   unixError:
  331.     interp->result = Tcl_PosixError (interp);
  332.     return TCL_ERROR;
  333.    
  334. }
  335.  
  336. /*
  337.  *-----------------------------------------------------------------------------
  338.  *
  339.  * Tcl_FcntlCmd --
  340.  *     Implements the fcntl TCL command:
  341.  *         fcntl handle attribute ?value?
  342.  *-----------------------------------------------------------------------------
  343.  */
  344. int
  345. Tcl_FcntlCmd (clientData, interp, argc, argv)
  346.     ClientData  clientData;
  347.     Tcl_Interp *interp;
  348.     int         argc;
  349.     char      **argv;
  350. {
  351.     FILE  *filePtr;
  352.  
  353.     if ((argc < 3) || (argc > 4)) {
  354.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], 
  355.                           " handle attribute ?value?", (char *) NULL);
  356.         return TCL_ERROR;
  357.     }
  358.  
  359.     if (Tcl_GetOpenFile (interp, argv [1], 
  360.                          FALSE, FALSE,   /* No access checking */
  361.                          &filePtr) != TCL_OK)
  362.     return TCL_ERROR;
  363.     if (argc == 3) {    
  364.         if (GetFcntlAttr (interp, filePtr, argv [2]) != TCL_OK)
  365.             return TCL_ERROR;
  366.     } else {
  367.         if (SetFcntlAttr (interp, filePtr, argv [2], argv [3]) != TCL_OK)
  368.             return TCL_ERROR;
  369.     }
  370.     return TCL_OK;
  371. }
  372.